home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cocktail / cg.lha / cg / src / c5.puma < prev    next >
Text File  |  1992-11-24  |  21KB  |  643 lines
  1. /* Ich, Doktor Josef Grosch, Informatiker, 27.3.1992 */
  2.  
  3. TRAFO EvalC3
  4. TREE Tree
  5. PUBLIC EvalImplC ToBit0
  6.  
  7. GLOBAL {
  8.  
  9. FROM SYSTEM    IMPORT ADR, TSIZE;
  10. FROM General    IMPORT Max;
  11. FROM DynArray    IMPORT MakeArray;
  12. FROM IO        IMPORT WriteS, WriteNl, WriteI, WriteB, StdOutput;
  13. FROM Texts    IMPORT WriteText;
  14. FROM Sets    IMPORT tSet, MakeSet, ReleaseSet, Include, Exclude, Minimum,
  15.             Maximum, IsElement, WriteSet, IsEmpty, Extract;
  16. FROM Relations    IMPORT IsRelated;
  17. FROM TreeC1    IMPORT BSS;
  18. FROM TreeC2    IMPORT GetIterator, Iterator, WriteLine;
  19. FROM EvalC    IMPORT Class;
  20. FROM Errors    IMPORT Error, Short, MessageI;
  21. FROM Positions    IMPORT NoPosition;
  22. IMPORT EvalC;
  23.  
  24. FROM Tree    IMPORT
  25.    NoTree    , tTree        , Referenced    , NoCodeClass    ,
  26.    Computed    , Reverse    , Write        , Read        ,
  27.    Inherited    , Synthesized    , Input        , Output    ,
  28.    Virtual    , Test        , Left        , Right        ,
  29.    HasOutput    , NonBaseComp    , Dummy        , Trace        ,
  30.    Demand    , Funct        , NoClass    , Options    ,
  31.    TreeRoot    , iModule    , iMain        , itTree    ,
  32.    ForallClasses, ForallAttributes, f        , WI    , WN    ,
  33.    ClassCount    , IdentifyClass    , IdentifyAttribute, 
  34.    tBitIndex    , tBitInfo    , iNoTree    , QueryTree    ;
  35.  
  36. VAR
  37.    i, i2, j, k, n, MaxBit, MaxInstCount, Check: SHORTCARD;
  38.    Node, Attr, ChildsClass    : tTree;
  39.    Success, IsStable        : BOOLEAN;
  40.    BitIndexSize            : LONGINT;
  41.    gBitIndex            : tBitIndex;
  42.    InhIndices            : tSet;
  43.    InhIndexSize            : LONGINT;
  44.    InhIndexCount        : POINTER TO ARRAY [1..1000000] OF SHORTCARD;
  45.  
  46. PROCEDURE GenCall (t: tTree; j: SHORTCARD);
  47.    BEGIN
  48.       WITH t^.Class.Instance^ [j] DO
  49.      IF ({Synthesized, Left} <= Properties) THEN
  50.         k := ToBit0 (t, j);
  51.         !IFNOTIN (! WN (k MOD BSS); !, yyt->yyHead.yyIsComp! WN (k DIV BSS); !) ! 
  52.         !yyS! WN (k); ! (yyt); /* ! WI (Attribute^.Child.Name); ! */ }!
  53.      ELSIF ({Inherited, Left} <= Properties) THEN
  54.         k := ToBit0 (t, j);
  55.         !IFNOTIN (! WN (k MOD BSS); !, yyt->yyHead.yyIsComp! WN (k DIV BSS); !) ! 
  56.    IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  57.         !yyVisitParent (yyt); ! 
  58.         !yyI [yyt->yyHead.yyOffset + ! WN (k); !](yyt->yyHead.yyParent); /* ! 
  59.         WI (Attribute^.Child.Name); ! */ ! 
  60.         @yyWriteVisit (yyt->yyHead.yyParent, "?"); }@
  61.    ELSE
  62.         !yyI [yyt->yyHead.yyOffset + ! WN (k); !](yyt->yyHead.yyParent); /* ! 
  63.         WI (Attribute^.Child.Name); ! */ }!
  64.    END;
  65.      ELSIF ({Inherited, Right} <= Properties) THEN
  66.         k := ToBit1 (Selector, j - t^.Class.AttrCount - Selector^.Child.InstOffset);
  67.         !IFNOTIN (! WN (k MOD BSS); !, yyt->! WI (Class^.Class.Name);
  68.         !.! WI (Selector^.Child.Name); !->yyHead.yyIsComp! WN (k DIV BSS); !) ! 
  69.         k := ToBit2 (t, Selector, j);
  70.         !yyI! WN (k); ! (yyt); /* ! WI (Selector^.Child.Name);
  71.         !:! WI (Attribute^.Child.Name); ! */ }!
  72.      ELSIF ({Synthesized, Right} <= Properties) THEN
  73.         k := ToBit1 (Selector, j - t^.Class.AttrCount - Selector^.Child.InstOffset);
  74.         !IFNOTIN (! WN (k MOD BSS); !, yyt->! WI (Class^.Class.Name);
  75.         !.! WI (Selector^.Child.Name); !->yyHead.yyIsComp! WN (k DIV BSS); !) ! 
  76.    IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  77.         @yyWriteVisit (yyt, "@ WI (Selector^.Child.Name); @"); @ 
  78.         !yyS! WN (k);
  79.         ! (yyt->! WI (Class^.Class.Name); !.! WI (Selector^.Child.Name);
  80.         !); /* ! WI (Selector^.Child.Name); !:! WI (Attribute^.Child.Name); ! */ ! 
  81.         !yyVisitParent (yyt->! WI (Class^.Class.Name); !.! WI (Selector^.Child.Name); !); }!
  82.    ELSE
  83.         !yyS! WN (k);
  84.         ! (yyt->! WI (Class^.Class.Name); !.! WI (Selector^.Child.Name);
  85.         !); /* ! WI (Selector^.Child.Name); !:! WI (Attribute^.Child.Name); ! */ }!
  86.    END;
  87.      END;
  88.       END;
  89.    END GenCall;
  90.  
  91. PROCEDURE GenEvalAttr (t: tTree; i: INTEGER);
  92.    BEGIN
  93.       Class := t;
  94.       WITH t^.Class.Instance^ [i] DO
  95.    IF IsElement (ORD ('X'), Options) AND (Trace IN t^.Class.Properties) THEN
  96.      @yyWriteEval (yyt, "@ WI (Attribute^.Child.Name); @");@
  97.      IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  98.         EvalC.GenEvaluator (Action); !!
  99.         IF Test IN Properties THEN
  100.            !writebool (yyb) yyWriteNl ();!
  101.         ELSIF (Attribute^.Kind = Tree.Child) OR (Attribute^.Attribute.Type = itTree) THEN
  102.            !write! WI (itTree);
  103.            ! (yyt->! WI (t^.Class.Name); !.! WI (Attribute^.Child.Name); !)!
  104.         ELSE
  105.            !write! WI (Attribute^.Child.Type);
  106.            ! (yyt->! WI (t^.Class.Name); !.! WI (Attribute^.Child.Name); !) yyWriteNl ();!
  107.         END;
  108.      ELSE
  109.         !yyWriteNl ();!
  110.      END;
  111.    ELSIF IsElement (ORD ('Y'), Options) AND (Trace IN t^.Class.Properties) THEN
  112.      @yyWriteEval (yyt, "@ WI (Attribute^.Child.Name); @");@
  113.      IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  114.         EvalC.GenEvaluator (Action);
  115.      END;
  116.    ELSE
  117.      IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  118.         EvalC.GenEvaluator (Action);
  119.      END;
  120.    END;
  121.       END;
  122.    END GenEvalAttr;
  123. }
  124.  
  125. PROCEDURE EvalImplC (t: Tree)
  126.     
  127. Ag (..) :- {
  128.     MaxBit := 0;
  129.     MaxInstCount := 0;
  130.     ForallClasses (Classes, CompBitInfo);
  131.     MakeSet (InhIndices, MaxInstCount);
  132.     InhIndexSize := MaxInstCount;
  133.     MakeArray (InhIndexCount, InhIndexSize, TSIZE (SHORTCARD));
  134.     FOR i := 1 TO MaxInstCount DO InhIndexCount^ [i] := 0; END;
  135.     ForallClasses (Classes, CompInhIndices);
  136.     @# define IFNOTIN(b, s) if (! (s & 1 << b)) {@
  137.     !# define INCL(s, b) s |= 1 << b!
  138.     !# define REMOTE_SYN(i, b, c, n, t, a) (n->yyHead.i & 1 << b ? (void) 0 : c (n), n->t.a)!
  139.     !# define REMOTE_INH(i, b, k, n, t, a) (n->yyHead.i & 1 << b ? (void) 0 : yyI [n->yyHead.yyOffset + k](n->yyHead.yyParent), n->t.a)!
  140.     EvalC.EvalImplHead (t);
  141.     !!
  142.     !static void yyE ARGS((register ! WI (itTree); ! yyt));!
  143.     FOR i := 1 TO MaxBit - 1 DO
  144.        !static void yyS! WN (i); ! ARGS((register ! WI (itTree); ! yyt));!
  145.     END;
  146.     FOR i := Minimum (InhIndices) TO Maximum (InhIndices) DO
  147.        IF IsElement (i, InhIndices) THEN
  148.           !static void yyI! WN (i); ! ARGS((register ! WI (itTree); ! yyt));!
  149.        END;
  150.     END;
  151.     !!
  152.     !static ! WI (iMain); !_tProcTree yyI [! WN (Maximum (InhIndices) + 1); !] = { 0,!
  153.     FOR i := 1 TO Maximum (InhIndices) DO
  154.        IF IsElement (i, InhIndices) THEN
  155.           ! yyI! WN (i); !,!
  156.        ELSE
  157.           ! 0,!
  158.        END;
  159.     END;
  160.     !};!
  161.     !!
  162.     !static void yyAbort!
  163.     !# if defined __STDC__ | defined __cplusplus!
  164.     ! (! WI (itTree); ! yyt)!
  165.     !# else!
  166.     ! (yyt) ! WI (itTree); ! yyt;!
  167.     !# endif!
  168.     !{!
  169.     @ (void) fprintf (stderr, "Error: module @ WI (EvalName); @, cyclic dependencies\n");@
  170.     ! ! WI (iMain); !_Exit ();!
  171.     !}!
  172.     !!
  173.     !void ! WI (EvalName); !!
  174.     !# if defined __STDC__ | defined __cplusplus!
  175.     ! (! WI (itTree); ! yyt)!
  176.     !# else!
  177.     ! (yyt) ! WI (itTree); ! yyt;!
  178.     !# endif!
  179.       IF NOT IsElement (ORD ('9'), Options) THEN
  180.     !{ Init! WI (iModule); ! (yyt); yyE (yyt); }!
  181.       ELSE
  182.     !{!
  183.     ! char xxHigh;!
  184.     ! xxStack = 1000000000;!
  185.     ! Init! WI (iModule); ! (yyt); yyE (yyt);!
  186.     @ (void) printf ("Stacksize %d\n", (int) & xxHigh - xxStack);@
  187.     !}!
  188.       END;
  189.     !!
  190.     REPEAT IsStable := TRUE; ForallClasses (Classes, CompOutput); UNTIL IsStable;
  191.     !static void yyE!
  192.     !# if defined __STDC__ | defined __cplusplus!
  193.     ! (register ! WI (itTree); ! yyt)!
  194.     !# else!
  195.     ! (yyt) register ! WI (itTree); ! yyt;!
  196.     !# endif!
  197.     !{!
  198.     WriteLine (TreeRoot^.Ag.EvalCodes^.Codes.LocalLine);
  199.     WriteText (f, TreeRoot^.Ag.EvalCodes^.Codes.Local);
  200.     Node := TreeRoot^.Ag.Modules;
  201.     WHILE Node^.Kind = Tree.Module DO
  202.        WriteLine (Node^.Module.EvalCodes^.Codes.LocalLine);
  203.        WriteText (f, Node^.Module.EvalCodes^.Codes.Local);
  204.        Node := Node^.Module.Next;
  205.     END;
  206.       IF IsElement (ORD ('9'), Options) THEN
  207.     ! char xxLow;!
  208.     ! xxStack = Min (xxStack, (int) & xxLow);!
  209.       END;
  210.     ! for (;;) {!
  211.     !  if (yyt == ! WI (iNoTree); ! || yyt->yyHead.yyIsComp0 & 1) return;!
  212.     !  yyt->yyHead.yyIsComp0 |= 1;!
  213.     !  switch (yyt->Kind) {!
  214.     ForallClasses (Classes, GenE);
  215.     !  default: return;!
  216.     !  }!
  217.     ! }!
  218.     !}!
  219.     !!
  220.     FOR i := 2 TO MaxBit DO
  221.        n := 0;            (* are there any SYN attributes ? *)
  222.        ForallClasses (Classes, CountSynAttr);
  223.        IF n > 0 THEN
  224.           !static void yyS! WN (i - 1); !!
  225.           !# if defined __STDC__ | defined __cplusplus!
  226.           ! (register ! WI (itTree); ! yyt)!
  227.           !# else!
  228.           ! (yyt) register ! WI (itTree); ! yyt;!
  229.           !# endif!
  230.           !{!
  231.           WriteLine (TreeRoot^.Ag.EvalCodes^.Codes.LocalLine);
  232.           WriteText (f, TreeRoot^.Ag.EvalCodes^.Codes.Local);
  233.           Node := TreeRoot^.Ag.Modules;
  234.           WHILE Node^.Kind = Tree.Module DO
  235.          WriteLine (Node^.Module.EvalCodes^.Codes.LocalLine);
  236.          WriteText (f, Node^.Module.EvalCodes^.Codes.Local);
  237.          Node := Node^.Module.Next;
  238.           END;
  239.       IF IsElement (ORD ('9'), Options) THEN
  240.           ! char xxLow;!
  241.           ! xxStack = Min (xxStack, (int) & xxLow);!
  242.       END;
  243.       IF IsElement (ORD ('5'), Options) THEN
  244.           ! IFNOTIN (! WN ((i - 1) MOD BSS); !, yyt->yyHead.yyIsDone! WN ((i - 1) DIV BSS);
  245.           !) INCL (yyt->yyHead.yyIsDone! WN ((i - 1) DIV BSS); !, ! WN ((i - 1) MOD BSS); !); } else yyAbort (yyt);!
  246.       END;
  247.           IF n > 1 THEN
  248.          ! switch (yyt->Kind) {!
  249.          ForallClasses (Classes, GenS);
  250.          ! }!
  251.           ELSE
  252.          ForallClasses (Classes, GenS);
  253.           END;
  254.           ! INCL (yyt->yyHead.yyIsComp! WN ((i - 1) DIV BSS); !, ! WN ((i - 1) MOD BSS); !);!
  255.           !}!
  256.           !!
  257.        END;
  258.     END;
  259.     FOR i := Minimum (InhIndices) TO Maximum (InhIndices) DO
  260.        IF IsElement (i, InhIndices) THEN
  261.           !static void yyI! WN (i); !!
  262.           !# if defined __STDC__ | defined __cplusplus!
  263.           ! (register ! WI (itTree); ! yyt)!
  264.           !# else!
  265.           ! (yyt) register ! WI (itTree); ! yyt;!
  266.           !# endif!
  267.           !{!
  268.           WriteLine (TreeRoot^.Ag.EvalCodes^.Codes.LocalLine);
  269.           WriteText (f, TreeRoot^.Ag.EvalCodes^.Codes.Local);
  270.           Node := TreeRoot^.Ag.Modules;
  271.           WHILE Node^.Kind = Tree.Module DO
  272.          WriteLine (Node^.Module.EvalCodes^.Codes.LocalLine);
  273.          WriteText (f, Node^.Module.EvalCodes^.Codes.Local);
  274.          Node := Node^.Module.Next;
  275.           END;
  276.       IF IsElement (ORD ('9'), Options) THEN
  277.           ! char xxLow;!
  278.           ! xxStack = Min (xxStack, (int) & xxLow);!
  279.       END;
  280.           Check := 0;
  281.           IF InhIndexCount^ [i] > 1 THEN
  282.          ! switch (yyt->Kind) {!
  283.          ForallClasses (Classes, EvalImplC);
  284.          ! }!
  285.           ELSE
  286.          ForallClasses (Classes, EvalImplC);
  287.           END;
  288.           IF Check # InhIndexCount^ [i] THEN
  289.              MessageI ("internal error in yyI", Error, NoPosition, Short, ADR (i));
  290.           END;
  291.           !}!
  292.           !!
  293.        END;
  294.     END;
  295.     !void Begin! WI (EvalName); ! ()!
  296.     !{!
  297.     WriteLine (EvalCodes^.Codes.BeginLine);
  298.     WriteText (f, EvalCodes^.Codes.Begin);
  299.     Node := Modules;
  300.     WHILE Node^.Kind = Tree.Module DO
  301.        WriteLine (Node^.Module.EvalCodes^.Codes.BeginLine);
  302.        WriteText (f, Node^.Module.EvalCodes^.Codes.Begin);
  303.        Node := Node^.Module.Next;
  304.     END;
  305.     !}!
  306.     !!
  307.     !void Close! WI (EvalName); ! ()!
  308.     !{!
  309.     WriteLine (EvalCodes^.Codes.CloseLine);
  310.     WriteText (f, EvalCodes^.Codes.Close);
  311.     Node := Modules;
  312.     WHILE Node^.Kind = Tree.Module DO
  313.        WriteLine (Node^.Module.EvalCodes^.Codes.CloseLine);
  314.        WriteText (f, Node^.Module.EvalCodes^.Codes.Close);
  315.        Node := Node^.Module.Next;
  316.     END;
  317.     !}!
  318. }; .
  319. Class (..) :-
  320.     NoCodeClass * Properties = {{}};
  321.     i <= InstCount;
  322.     a: SHORTCARD;
  323. {    a := ToAttr (t, i);
  324.     IF a = 0 THEN RETURN; END;
  325.     WITH Instance^ [a] DO
  326.        IF {Inherited, Right} <= Properties THEN
  327.           Class := t;
  328.           IF InhIndexCount^ [i] > 1 THEN
  329.          !  case k! WI (Name); !:!
  330.           END;
  331.           INC (Check);
  332.           k := ToBit1 (Selector, a - AttrCount - Selector^.Child.InstOffset);
  333.       IF IsElement (ORD ('5'), Options) THEN
  334.           ! IFNOTIN (! WN (k MOD BSS); !, yyt->! WI (Class^.Class.Name);
  335.           !.! WI (Selector^.Child.Name); !->yyHead.yyIsDone! WN (k DIV BSS);
  336.           !) INCL (yyt->! WI (Class^.Class.Name); !.! WI (Selector^.Child.Name);
  337.           !->yyHead.yyIsDone! WN (k DIV BSS); !, ! WN (k MOD BSS); !); } else yyAbort (yyt);!
  338.       END;
  339.           FOR j := 1 TO InstCount DO
  340.          IF IsRelated (a, j, DP) THEN
  341.             GenCall (t, j);
  342.          END;
  343.           END;
  344.       IF IsElement (ORD ('X'), Options) AND (Trace IN t^.Class.Properties) THEN
  345.           @yyWriteEval (yyt, "@ WI (Selector^.Child.Name); !:! WI (Attribute^.Child.Name); @");@
  346.           IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  347.          EvalC.GenEvaluator (Action); !!
  348.          IF (Attribute^.Kind = Tree.Child) OR (Attribute^.Attribute.Type = itTree) THEN
  349.             !write! WI (itTree);
  350.             ! (yyt->! WI (Name); !.! WI (Selector^.Child.Name);
  351.             !->! WI (Selector^.Child.Type); !.! WI (Attribute^.Child.Name); !)!
  352.          ELSE
  353.             !write! WI (Attribute^.Child.Type);
  354.             ! (yyt->! WI (Name); !.! WI (Selector^.Child.Name);
  355.             !->! WI (Selector^.Child.Type); !.! WI (Attribute^.Child.Name); !) yyWriteNl ();!
  356.          END;
  357.           ELSE
  358.          !yyWriteNl ();!
  359.           END;
  360.       ELSIF IsElement (ORD ('Y'), Options) AND (Trace IN t^.Class.Properties) THEN
  361.           @yyWriteEval (yyt, "@ WI (Selector^.Child.Name); !:! WI (Attribute^.Child.Name); @");@
  362.           IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  363.          EvalC.GenEvaluator (Action);
  364.           END;
  365.       ELSE
  366.           IF (Action # ADR (Action)) AND NOT (Virtual IN Properties) THEN
  367.          EvalC.GenEvaluator (Action);
  368.           END;
  369.       END;
  370.           IF NOT (Input IN Properties) AND (Attribute^.Kind = Tree.Child) THEN
  371.          !{ register ! WI (itTree); ! yyr = yyt->! WI (Name); !.! WI (Selector^.Child.Name);
  372.          !->! WI (Selector^.Child.Type); !.! WI (Attribute^.Child.Name);
  373.          !; if (yyr->yyHead.yyParent == ! WI (iNoTree);
  374.          !) { yyr->yyHead.yyOffset = ! WN (Selector^.Child.Class^.Class.BitCount + Attribute^.Child.BitOffset);
  375.          !; yyr->yyHead.yyParent = yyt->! WI (Name); !.! WI (Selector^.Child.Name);
  376.          !; Init! WI (iModule); ! (yyr); } }!
  377.           END;
  378.           FOR i2 := 1 TO InstCount DO    (* add group members *)
  379.          IF Instance^[i2].Action = Action THEN
  380.             WITH Instance^[i2] DO
  381.                IF Synthesized IN Properties THEN
  382.               k := ToBit0 (Class, i2);
  383.               !  INCL (yyt->yyHead.yyIsComp! WN (k DIV BSS); !, ! WN (k MOD BSS); !);!
  384.                ELSIF Inherited IN Properties THEN
  385.               k := ToBit1 (Selector, i2 - AttrCount - Selector^.Child.InstOffset);
  386.               !  INCL (yyt->! WI (Class^.Class.Name); !.! WI (Selector^.Child.Name);
  387.               !->yyHead.yyIsComp! WN (k DIV BSS); !, ! WN (k MOD BSS); !);!
  388.                END;
  389.             END;
  390.          END;
  391.           END;
  392.           ! return;!
  393.        END;
  394.     END;
  395. }; .
  396.  
  397. PROCEDURE CompBitInfo (t: Tree)
  398.  
  399. Class (..) :-
  400.     BitIndexSize := AttrCount;
  401.     MakeArray (BitIndex, BitIndexSize, TSIZE (tBitInfo));
  402.     i := 1;
  403.     gBitIndex := BitIndex;
  404.     ForallAttributes (t, CompBitInfo);
  405.     MaxBit := Max (i, MaxBit);
  406.     MaxInstCount := Max (InstCount, MaxInstCount);
  407.     .
  408. Child (..) ;
  409. Attribute (..) :-
  410.     ({{Input, Test, Dummy}} * Properties = {{}});
  411.     INC (i);
  412.     gBitIndex^ [AttrIndex].ToBit := i;
  413.     gBitIndex^ [i].ToAttr := AttrIndex;
  414.     .
  415.  
  416. PROCEDURE CompInhIndices (t: Tree)
  417.  
  418. Class (..) :-
  419.     b: INTEGER;
  420. {    FOR j := AttrCount + 1 TO InstCount DO
  421.        WITH Instance^ [j] DO
  422.           IF Inherited IN Properties THEN
  423.          b := ToBit2 (t, Selector, j);
  424.          Include (InhIndices, b);
  425.          INC (InhIndexCount^ [b]);
  426.           END;
  427.        END;
  428.     END;
  429. };    .
  430.  
  431. PROCEDURE CountSynAttr (t: Tree)
  432.  
  433. Class (..) :-
  434.     NoCodeClass * Properties = {{}};
  435.     i <= BitCount;
  436. {    WITH Instance^ [BitIndex^ [i].ToAttr] DO
  437.        IF ({Synthesized, Left} <= Properties) AND NOT (Test IN Properties) THEN
  438.           INC (n);
  439.        END;
  440.     END;
  441. };    .
  442.  
  443. PROCEDURE TypeName (t: Tree)
  444.  
  445. Class (..) :-
  446.     NoCodeClass * Properties = {{}};
  447.     Trace IN Properties;
  448.     @"@ WI (Name); @",@
  449.     .
  450.  
  451. PROCEDURE GenS (t: Tree)
  452.  
  453. Class (..) :-
  454.     NoCodeClass * Properties = {{}};
  455.     i <= BitCount;
  456. {    WITH Instance^ [BitIndex^ [i].ToAttr] DO
  457.        IF ({Synthesized, Left} <= Properties) AND NOT (Test IN Properties) THEN
  458.           Class := t;
  459.           IF n > 1 THEN
  460.          ! case k! WI (Name); !:!
  461.           END;
  462.           FOR j := 1 TO InstCount DO
  463.          IF IsRelated (BitIndex^ [i].ToAttr, j, DP) THEN
  464.             GenCall (t, j);
  465.          END;
  466.           END;
  467.           GenEvalAttr (t, BitIndex^ [i].ToAttr);
  468.           IF NOT (Input IN Properties) AND (Attribute^.Kind = Tree.Child) THEN
  469.          !{ register ! WI (itTree); ! yyr = yyt->! WI (Name); !.! WI (Attribute^.Child.Name);
  470.          !; if (yyr->yyHead.yyParent == ! WI (iNoTree);
  471.          !) { yyr->yyHead.yyOffset = ! WN (BitCount + Attribute^.Child.BitOffset);
  472.          !; yyr->yyHead.yyParent = yyt; Init! WI (iModule); ! (yyr); } }!
  473.           END;
  474.           FOR i2 := 1 TO InstCount DO    (* add group members *)
  475.          IF Instance^[i2].Action = Action THEN
  476.             WITH Instance^[i2] DO
  477.                IF Synthesized IN Properties THEN
  478.               k := ToBit0 (Class, i2);
  479.               IF k # i - 1 THEN
  480.                  !  INCL (yyt->yyHead.yyIsComp! WN (k DIV BSS); !, ! WN (k MOD BSS); !);!
  481.               END;
  482.                ELSIF Inherited IN Properties THEN
  483.               k := ToBit1 (Selector, i2 - AttrCount - Selector^.Child.InstOffset);
  484.               !  INCL (yyt->! WI (Class^.Class.Name); !.! WI (Selector^.Child.Name);
  485.               !->yyHead.yyIsComp! WN (k DIV BSS); !, ! WN (k MOD BSS); !);!
  486.                END;
  487.             END;
  488.          END;
  489.           END;
  490.           IF n > 1 THEN
  491.          !  break;!
  492.           END;
  493.        END;
  494.     END;
  495. }; .
  496.  
  497. PROCEDURE GenE (t: Tree)
  498.  
  499. Class (..) :-
  500.     ToCompute: tSet;
  501. {    GetIterator (t);
  502.     n := 0;
  503.     j := 2;
  504.     LOOP
  505.        IF j > InstCount THEN EXIT; END;
  506.        WITH Instance^ [j] DO
  507.           IF {Dummy, Output, Test} * Properties # {} THEN
  508.              IF (Test IN Properties) OR
  509.             ({Synthesized, Left} <= Properties) OR
  510.             ({Inherited,  Right} <= Properties) OR
  511.             ({Inherited,   Left} <= Properties) AND
  512.             NOT (Input IN Properties) AND (Attribute^.Kind = Tree.Child) OR
  513.             ({Synthesized, Right, Dummy} <= Properties) AND (Selector # Iterator) AND
  514.             (HasOutput IN Selector^.Child.Class^.Class.Properties) THEN
  515.             INC (n); EXIT;
  516.          END;
  517.           END;
  518.        END;
  519.        INC (j);
  520.     END;
  521.     IF (n = 0) AND ((Iterator = NoTree) OR NOT (HasOutput IN Iterator^.Child.Class^.Class.Properties)) THEN RETURN; END;
  522.  
  523.     Class := t;
  524.     !  case k! WI (Name); !:!
  525.     FOR j := 2 TO InstCount DO
  526.        WITH Instance^ [j] DO
  527.           IF {Dummy, Output} * Properties # {} THEN
  528.          IF ({Synthesized, Left} <= Properties) OR
  529.             ({Inherited,  Right} <= Properties) OR
  530.             ({Inherited,   Left} <= Properties) AND
  531.             NOT (Input IN Properties) AND (Attribute^.Kind = Tree.Child) THEN
  532.             GenCall (t, j);
  533.          ELSIF ({Synthesized, Right, Dummy} <= Properties) AND (Selector # Iterator) AND
  534.             (HasOutput IN Selector^.Child.Class^.Class.Properties) THEN
  535.       IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  536.             @yyWriteVisit (yyt, "@ WI (Selector^.Child.Name); @"); @ 
  537.       END;
  538.             !yyE (yyt->! WI (Name); !.! WI (Selector^.Child.Name); !);!
  539.       IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  540.             !yyVisitParent (yyt->! WI (Name); !.! WI (Selector^.Child.Name); !);!
  541.       END;
  542.          END;
  543.           END;
  544.        END;
  545.     END;
  546.  
  547.     MakeSet (ToCompute, InstCount);
  548.     FOR i := 2 TO AttrCount DO
  549.        WITH Instance^ [i] DO
  550.           IF Test IN Properties THEN
  551.          FOR j := 2 TO InstCount DO
  552.             IF IsRelated (i, j, DP) THEN
  553.                IF {Synthesized, Inherited} * Instance^ [j].Properties # {} THEN
  554.               Include (ToCompute, j);
  555.                END;
  556.             END;
  557.          END;
  558.           END;
  559.        END;
  560.     END;
  561.     FOR i := 2 TO InstCount DO
  562.        WITH Instance^ [i] DO
  563.           IF ({Synthesized, Left, Output} <= Properties) OR
  564.          ({Inherited,  Right, Output} <= Properties) THEN
  565.          Exclude (ToCompute, i);
  566.           END;
  567.        END;
  568.     END;
  569.     WHILE NOT IsEmpty (ToCompute) DO
  570.        GenCall (t, Extract (ToCompute));
  571.     END;
  572.     ReleaseSet (ToCompute);
  573.     FOR i := 2 TO AttrCount DO
  574.        IF Test IN Instance^ [i].Properties THEN
  575.           GenEvalAttr (t, i);
  576.        END;
  577.     END;
  578.  
  579.     IF (Iterator = NoTree) OR NOT (HasOutput IN Iterator^.Child.Class^.Class.Properties) THEN
  580.        !return;!
  581.     ELSE
  582.       IF IsElement (ORD ('Z'), Options) AND (Trace IN t^.Class.Properties) THEN
  583.        @yyWriteVisit (yyt, "@ WI (Iterator^.Child.Name); @"); @ 
  584.       END;
  585.        !yyt = yyt->! WI (Name); !.! WI (Iterator^.Child.Name); !; break;!
  586.     END;
  587. }; .
  588.  
  589. PROCEDURE CompOutput (t: Tree)
  590.  
  591. Class (..) :-
  592.    NOT (HasOutput IN Properties);
  593.    Success := FALSE;
  594.    ForallAttributes (t, CompOutput);
  595.    ForallClasses (Extensions, CompOutput2);
  596.    Success;
  597.    INCL (Properties, HasOutput);
  598.    IsStable := FALSE;
  599.    .
  600. Child (..) :-
  601.    (Output IN Properties) OR (HasOutput IN Class^.Class.Properties);
  602.    Success := TRUE;
  603.    .
  604. Attribute (..) :-
  605.    ({{Test, Output}} * Properties # {{}});
  606.    Success := TRUE;
  607.    .
  608.  
  609. PROCEDURE CompOutput2 (t: Tree)
  610.  
  611. Class (..) :-
  612.    HasOutput IN Properties;
  613.    Success := TRUE;
  614.    .
  615.  
  616. FUNCTION ToBit0 (Class, INTEGER) INTEGER
  617.    class, i ? RETURN class^.Class.BitIndex^ [i].ToBit - 1; .
  618.  
  619. FUNCTION ToBit1 (Child, INTEGER) INTEGER
  620.    Selector, i ? RETURN Selector^.Child.Class^.Class.BitIndex^ [i].ToBit - 1; .
  621.  
  622. FUNCTION ToBit2 (Class, Child, SHORTCARD) INTEGER
  623.    class, Selector, i RETURN _ ?
  624. {  WITH Selector^.Child DO
  625.       RETURN class^.Class.BitCount + BitOffset +
  626.      Class^.Class.BitIndex^ [i - class^.Class.AttrCount - InstOffset].ToBit - 1;
  627.    END;
  628. }; .
  629.  
  630. FUNCTION ToAttr (Class, INTEGER) INTEGER
  631.    LOCAL { VAR a: SHORTCARD; }
  632.    class, i RETURN _ ?
  633. {  WITH class^.Class DO
  634.       FOR a := AttrCount + 1 TO InstCount DO
  635.      WITH Instance^ [a] DO
  636.         IF ({Input, Test, Dummy} * Properties = {}) AND
  637.            (ToBit2 (class, Selector, a) = i) THEN RETURN a; END;
  638.      END;
  639.       END;
  640.    END;
  641.    RETURN 0;
  642. }; .
  643.